home *** CD-ROM | disk | FTP | other *** search
/ Computer Select (Limited Edition) / Computer Select.iso / dobbs / v17n05 / structpr.asc < prev    next >
Encoding:
Text File  |  1992-03-30  |  8.8 KB  |  296 lines
  1. _STRUCTURED PROGRAMMING COLUMN_
  2. by Jeff Duntemann
  3.  
  4. [LISTING ONE]
  5.  
  6. {--------------------------------------------------------------}
  7. {                            JLIST10                           }
  8. {   Multifile source code lister with 8-char tab expansion     }
  9. {                                    by Jeff Duntemann         }
  10. {                                    Turbo Pascal V6.0         }
  11. {                                    Last update 1/1/92        }
  12. {--------------------------------------------------------------}
  13.  
  14. PROGRAM JList10;
  15.  
  16. USES DOS,CRT,Printer,  { Standard Borland units }
  17.      DirList,          { From DDJ for 4/92      }
  18.      When2;            { From DDJ for 1/92      }
  19. CONST
  20.   Up           = True;
  21.   Down         = False;
  22.   Single       = True;
  23.   Double       = False;
  24.   SingleRule   = Chr(196);  { D }
  25.   DoubleRule   = Chr(205);  { M }
  26.  
  27.   JLogo : ARRAY[1..4] OF STRING =
  28.  
  29.   ('  DBDD     ZDDDDDDDBDDD     ZDD?',
  30.    '   3  3  B @DDD?   3      ? 3  3',
  31.    '   3  3  3     3   3      3 3  3',
  32.    '  DY  @D A DDDDY   A      A @DDY');
  33.   ESC1         = Chr($1B);
  34.   ESC2         = ESC1+Chr($5B);
  35.  
  36.   LinesPerPage = 75;        { 75 assumes 8 lines per inch }
  37.  
  38. TYPE
  39.   String80 = STRING[80];
  40. VAR
  41.   InChar       : Char;
  42.   PrintPage    : Boolean;
  43.   Space10      : String80;
  44.   ListLine     : String;
  45.   I,J          : Integer;
  46.   FileSpecs    : String80;
  47.   FileInfo     : String;
  48.   PrintCommand     : String80;
  49.   FilesToPrint : PDirEntryCollection;
  50.   FileTime,Now : When;    { "When" stamps for time/date processing }
  51.  
  52. {---------------------------------------------------------------}
  53. {                  PRINTER CONTROL ROUTINES                     }
  54. {  These routines are all, to some extent, printer dependent.   }
  55. {  Here, the control codes are specific to the HP LJII/III.     }
  56. {---------------------------------------------------------------}
  57. PROCEDURE PrinterReset;
  58. BEGIN
  59.   Write(LST,ESC1+'E');
  60. END;
  61.  
  62. PROCEDURE PrinterToXY(X,Y : Integer);
  63. BEGIN
  64.   Write(LST,ESC1+'&a',Y-1,'R');
  65.   Write(LST,ESC1+'&a',X-1,'C');
  66. END;
  67.  
  68. PROCEDURE SetPrinterLinesPerInch(Lines : Integer);
  69. BEGIN
  70.   Write(LST,ESC1+'&l',Lines,'D');
  71. END;
  72.  
  73. PROCEDURE SetLinePrinterFont;
  74. BEGIN
  75.   Write(LST,ESC1+'(s16.66H'); { Select Lineprinter font      }
  76. END;
  77.  
  78. PROCEDURE SetIBMCharacterSet;
  79. BEGIN
  80.   Write(LST,ESC1+'(10U');     { Select IBM PC symbol set     }
  81. END;
  82.  
  83. {-----------------------------------------}
  84. {       END PRINTER-DEPENDENT CODE        }
  85. {-----------------------------------------}
  86.  
  87. PROCEDURE SendFormFeed;
  88. BEGIN
  89.   Write(LST,Chr(12))
  90. END;
  91.  
  92. FUNCTION ForceCase(Up : BOOLEAN; Target : String) : String;
  93. CONST
  94.   Uppercase : SET OF Char = ['A'..'Z'];
  95.   Lowercase : SET OF Char = ['a'..'z'];
  96. VAR
  97.   I : INTEGER;
  98. BEGIN
  99.   IF Up THEN FOR I := 1 TO Length(Target) DO
  100.     IF Target[I] IN Lowercase THEN
  101.       Target[I] := UpCase(Target[I])
  102.     ELSE { NULL }
  103.   ELSE FOR I := 1 TO Length(Target) DO
  104.     IF Target[I] IN Uppercase THEN
  105.       Target[I] := Chr(Ord(Target[I])+32);
  106.   ForceCase := Target
  107. END;
  108.  
  109. PROCEDURE PrintRule(ShowSingle : Boolean; StartColumn,EndColumn : Integer);
  110. VAR
  111.   RuleChar : Char;
  112.   I        : Integer;
  113. BEGIN
  114.   IF ShowSingle THEN RuleChar := SingleRule ELSE RuleChar := DoubleRule;
  115.   FOR I := 1 TO StartColumn-1 DO Write(LST,' ');
  116.   FOR I := StartColumn TO EndColumn DO Write(LST,RuleChar);
  117. END;
  118.  
  119. PROCEDURE PrintStartBanner(FilesToPrint : PDirEntryCollection);
  120. VAR
  121.   TotalFiles : Integer;
  122.   TotalBytes : LongInt;
  123.  
  124. PROCEDURE ShowSpecs(Target : PDirEntry); FAR;
  125. BEGIN
  126.   TotalFiles := Succ(TotalFiles);
  127.   TotalBytes := TotalBytes + Target^.Entry.Size;
  128.   Writeln(LST,Target^.DirLine);
  129. END;
  130. BEGIN
  131.   TotalFiles := 0;  TotalBytes := 0;
  132.   SetPrinterLinesPerInch(12);
  133.   FOR I := 1 TO 7 DO
  134.     BEGIN
  135.       PrintRule(Double,1,134); Writeln(LST);
  136.     END;
  137.   FOR I := 1 TO 4 DO Writeln(LST,JLogo[I]);
  138.   FOR I := 1 TO 7 DO
  139.     BEGIN
  140.       PrintRule(Double,1,134); Writeln(LST);
  141.     END;
  142.   SetPrinterLinesPerInch(6);
  143.   PrinterToXY(1,12);
  144.   Write  (LST,'Printer job initiated at '+Now.GetTimeString+'m');
  145.   Writeln(LST,'  on '+Now.GetLongDateString);
  146.   PrintRule(Single,1,134); Writeln(LST);
  147.   Writeln(LST,'Requested filespec: ',FileSpecs);
  148.   Writeln(LST,'Files to be printed:');
  149.   Writeln(LST);
  150.  
  151.   FilesToPrint^.ForEach(@ShowSpecs);
  152.  
  153.   PrintRule(Single,1,134); Writeln(LST);
  154.   Writeln(LST,'Total number of files to be printed: ',TotalFiles);
  155.   Writeln(LST,'Total number of bytes to be printed: ',TotalBytes);
  156.   SendFormFeed;
  157. END;
  158.  
  159. {->>>>PrintFile<<<<-}
  160. PROCEDURE PrintFile(ToBePrinted : PDirEntry);
  161. VAR
  162.   LineNumber,PageNumber : Integer;
  163.   ListFileName          : String80;
  164.   ListFile              : Text;
  165.  
  166. PROCEDURE PrintLine(LineToPrint : String; LineNumber : Integer);
  167. CONST
  168.   TabChar = Chr(9);
  169. VAR
  170.   I,J,LinePos,UpstreamPos,AddBlanks : Integer;
  171.   Space8 : String80;
  172. BEGIN
  173.   Space8 := '        ';
  174.   Write(LST,Space8,LineNumber : 4,'   ');
  175.   LinePos := 1;
  176.   FOR I := 1 TO Length(LineToPrint) DO
  177.     IF LineToPrint[I] = TabChar THEN   { Expand tabs }
  178.       BEGIN
  179.         UpstreamPos := (((LinePos + 7) DIV 8) * 8) + 1;
  180.         AddBlanks := UpstreamPos - LinePos;
  181.         FOR J := 1 TO AddBlanks DO Write(LST,' ');
  182.         LinePos := UpstreamPos
  183.       END
  184.     ELSE
  185.       BEGIN
  186.         Write(LST,LineToPrint[I]);
  187.         LinePos := Succ(LinePos)
  188.       END;
  189.   Writeln(LST)
  190. END;
  191.  
  192. PROCEDURE PrintHeader;
  193. VAR
  194.   I : Integer;
  195.   Space8 : String80;
  196. BEGIN
  197.   Space8 := '        ';
  198.   Writeln(LST,Space8,'FILE: ',ForceCase(Up,ListFileName),
  199.           ' Version of ',FileTime.GetDateString,' ',
  200.           FileTime.GetTimeString,'m        Printed on ',
  201.           Now.GetLongDateString,'  at ',Now.GetTimeString,'m.',
  202.           '    Page ',PageNumber);
  203.   Write(LST,Space8);
  204.   FOR I := 1 TO 116 DO Write(LST,Chr(196)); Writeln(LST);
  205.   Writeln(LST);
  206.   Writeln(LST);
  207. END;
  208.  
  209. BEGIN   { PrintFile }
  210.   LineNumber := 1; PageNumber := 1; Space10 := '       ';
  211.   ListFileName := ToBePrinted^.Path+ToBePrinted^.Entry.Name;
  212.   Assign(ListFile,ListFileName);
  213.   Reset(ListFile);
  214.  
  215.   IF NOT EOF(ListFile) THEN PrintHeader;
  216.   WHILE NOT EOF(ListFile) DO
  217.     BEGIN
  218.       Readln(ListFile,ListLine);
  219.       PrintLine(ListLine,LineNumber);
  220.       LineNumber := Succ(LineNumber);
  221.       IF ((LineNumber-1) DIV LinesPerPage) > (PageNumber - 1) THEN
  222.         BEGIN
  223.           PageNumber := Succ(PageNumber);
  224.           SendFormFeed;
  225.           PrintHeader;
  226.         END
  227.     END;
  228.   IF (LineNumber MOD LinesPerPage) > 1 THEN SendFormFeed;
  229.   Close(ListFile);
  230. END;  { PrintFile }
  231.  
  232. PROCEDURE SetupPrinter;
  233. BEGIN
  234.   SetLinePrinterFont;
  235.   SetIBMCharacterSet;
  236. END;
  237.  
  238. PROCEDURE PrintAllFiles(FilesToPrint : PDirEntryCollection);
  239. { This is the FAR local routine passed to the iterator method. }
  240. { It's called once for each item in the collection: }
  241. PROCEDURE PrintOneFile(Target : PDirEntry); FAR;
  242. BEGIN
  243.   FileTime.PutWhenStamp(Target^.Entry.Time);
  244.   PrintFile(Target);
  245. END;
  246.  
  247. BEGIN
  248.   { This is how you iterate a procedure over a collection: }
  249.   FilesToPrint^.ForEach(@PrintOneFile);
  250. END;
  251.  
  252. BEGIN                     { JLIST10 Main }
  253.   IF ParamCount = 0 THEN
  254.     BEGIN
  255.       Writeln('>>>JLIST10<<< by Jeff Duntemann');
  256.       Writeln('  Multifile listing utility');
  257.       Writeln('  for the HP Laserjet Series II');
  258.       Writeln('  Version of 12/31/91 -- Expands fixed 8-char tabs...');
  259.       Writeln('  WARNING:  Emits printer control strings that are');
  260.       Writeln('            *highly* specific to the HP Laserjet II!');
  261.       Writeln;
  262.       Writeln('Invocation syntax:');
  263.       Writeln;
  264.       Writeln('  JLIST10 <filespec>,[<filespec>..] CR');
  265.       Writeln;
  266.       Writeln('where <filespec> is the file or files to be printed,');
  267.       Writeln('using the DOS filespec conventions, including wildcard');
  268.       Writeln('characters * and ?.  A banner will be printed initially');
  269.       Writeln('with a summary of all files to be printed IF any wildcard');
  270.       Writeln('characters were entered as part of the file specification.');
  271.     END
  272.   ELSE
  273.     BEGIN
  274.       Now.PutNow;       { Fill a When stamp with today's time and date }
  275.       FileSpecs := '';     { Concatenate all file specs into 1 string: }
  276.       FOR I := 1 TO ParamCount DO FileSpecs := FileSpecs+' '+ParamStr(I);
  277.       FilesToPrint := New(PDirEntryCollection, InitCommandLine(128,16,1));
  278.       IF FilesToPrint^.Count > 0 THEN
  279.         BEGIN
  280.           Writeln;
  281.           Write('>>>Jlist10 is printing ',FilesToPrint^.Count,' file(s)...');
  282.           SetupPrinter;
  283.           IF FilesToPrint^.Count > 1 THEN PrintStartBanner(FilesToPrint);
  284.           SetPrinterLinesPerInch(8);
  285.  
  286.           PrintAllFiles(FilesToPrint);
  287.  
  288.           PrinterReset;            { Reset printer at job end }
  289.           Writeln;
  290.         END
  291.       ELSE
  292.         Writeln('No files match that file spec.');
  293.     END;
  294. END.
  295.  
  296.